home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / paragraphs.tcl < prev    next >
Encoding:
Text File  |  2000-02-27  |  11.1 KB  |  342 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "paragraphs.tcl"
  6.  #                                    created: 10/29/1999 {14:12:52 PM} 
  7.  #                                last update: 02/27/2000 {17:49:03 PM} 
  8.  #
  9.  #  Author: largely Vince Darley; originals probably Pete Keleher
  10.  #  E-mail: <vince@santafe.edu>
  11.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501, USA
  12.  #     www: <http://www.santafe.edu/~vince/>
  13.  #  
  14.  # ###################################################################
  15.  ##
  16.  
  17. namespace eval paragraph {}
  18.  
  19. ## 
  20.  # -------------------------------------------------------------------------
  21.  # 
  22.  # "paragraph::fill" --
  23.  # 
  24.  #  If there's a selection, then fill all paragraphs in that selection.
  25.  #  If not then fill the paragraph surrounding the insertion point.
  26.  #  The definition of a 'paragraph' may be mode dependent (see
  27.  #  paraStart, paraFinish)
  28.  #       
  29.  # -------------------------------------------------------------------------
  30.  ##
  31.  
  32. proc paragraph::fill {} {
  33.     if {[pos::compare [getPos] == [selEnd]]} {
  34.     paragraph::fillOne
  35.     } else {    
  36.     set start [getPos]
  37.     set end [selEnd]
  38.     set p $start
  39.     while {[pos::compare $p < $end] && [pos::compare $p < [maxPos]]} {
  40.         goto $p
  41.         set p [paragraph::fillOne 0 $start $end]
  42.     }
  43.     goto $start
  44.     }
  45. }
  46.  
  47. ## 
  48.  # -------------------------------------------------------------------------
  49.  # 
  50.  # "paragraph::fillOne" --
  51.  # 
  52.  #  Fills the single paragraph surrounding the insertion point.  If called
  53.  #  with parameter '0', it doesn't bother to remember where the insertion
  54.  #  point was, which makes multiple paragraph fills quicker when called by
  55.  #  'fillParagraph'.  Works for mode-dependent definitions of paragraphs and
  56.  #  for commented out text (such as this paragraph here!).  
  57.  #  Fixes: won't put a double-space after abbreviations like 'e.g.', 'i.e.'
  58.  #  
  59.  #  Works around the Alpha 'replaceText' bug.
  60.  # -------------------------------------------------------------------------
  61.  ##
  62. proc paragraph::fillOne {{remember 1} {minstart ""} {maxend ""}} {
  63.     global leftFillColumn fillColumn doubleSpaces
  64.  
  65.     set pos [getPos]
  66.     if {[set inComment [text::isInComment $pos ch]]} {
  67.     # Find lines which contain just a comment char, but no actual text
  68.     # (We want to flow the text in the comment in its constituent
  69.     # paragraphs, not as one big block).
  70.     set ch [string trim $ch]
  71.     set chreg [quote::Regfind ${ch}]
  72.     if {$ch == "*"} {
  73.         # We assume it's a C-style comment
  74.         set start [pos::math [lindex [search -s -f 0 -r 1 "^\[ \t\]*(${chreg}+|/\\*+)\[ \t\]*\$" $pos] 1] +1]
  75.         set end [lindex [search -s -f 1 -r 1 "^\[ \t\]*(${chreg}+|\\*+/)\[ \t\]*\$" $pos] 0]
  76.     } else {
  77.         set start [lindex [search -s -n -f 0 -r 1 "^\[ \t\]*(${chreg}+\[ \t\]*${chreg}*\$|\[^${chreg} \t\]|\$)" $pos] 0]
  78.         set end [lindex [search -s -n -f 1 -r 1 "^\[ \t\]*(${chreg}+\[ \t\]*${chreg}*\$|\[^${chreg} \t\]|\$)" $pos] 0]
  79.         # The comment doesn't have a leading/trailing almost blank line
  80.         # Look for any line which is either blank, or starts with a 
  81.         # different character
  82.         if {$start == ""} {
  83.         set start [nextLineStart [lindex [search -s -f 0 -r 1 "^\[ \t\]*(\[^ \t[string index $ch 0]\]|\$)" $pos] 0]]
  84.         } else {
  85.         set start [nextLineStart $start]
  86.         }
  87.         if {$end == ""} {
  88.         set end [lindex [search -s -f 1 -r 1 "^\[ \t\]*(\[^ \t[string index $ch 0]\]|\$)" $pos] 0]
  89.         }
  90.     }
  91.     } else {
  92.     set start [paragraph::start $pos] 
  93.     if {[pos::compare $start > $pos]} {
  94.         set end [paragraph::finish $start]
  95.     } else {
  96.         set end [paragraph::finish $pos]
  97.     }
  98.     }
  99.     # Extra arguments allow us to specify a region in which to operate
  100.     if {$minstart != ""} {
  101.     if {[pos::compare $minstart > $start]} {
  102.         set start $minstart
  103.     }
  104.     }
  105.     if {$maxend != ""} {
  106.     if {[pos::compare $maxend < $end]} {
  107.         set end $maxend
  108.     }
  109.     }
  110.     
  111.     if {$remember} {
  112.     if {$inComment} {
  113.         set memory [rememberWhereYouAre $start $pos $end $chreg]
  114.     } else {
  115.         set memory [rememberWhereYouAre $start $pos $end]
  116.     }
  117.     }
  118.     
  119.     if {$inComment} {
  120.     set text [getText $start [nextLineStart $start]]
  121.     if {[set boxComment [regexp -- "(${chreg}+)\[\r\n\]" $text "" commentSuffix]]} {
  122.         set boxWidth [posX [pos::math [nextLineStart $start] -1]]
  123.     }
  124.     regsub -all -- $chreg $text [string range "   " 1 [string length $ch]] fr
  125.     regexp "^\[ \t\]*" $fr fr
  126.     set left [string length [text::maxSpaceForm $fr]]
  127.     if {$boxComment} {
  128.         set newFillColumn [expr {$boxWidth - $left - [string length $commentSuffix] -2}]
  129.     } else {
  130.         set newFillColumn [expr {$fillColumn - $left}]
  131.     }
  132.     
  133.     if {![regexp "^((\[ \t\]*${chreg}+)\[ \t\]*)" $text "" front commentPrefix]} {
  134.         alertnote "Sorry, I can't yet reflow the text inside this comment."
  135.         return $end
  136.     }
  137.     if {$boxComment} {
  138.         regsub -all "[quote::Regfind $commentSuffix](\r|\n|$)" [getText $start $end] "\\1" text
  139.         regsub -all "(^|\r|\n)[quote::Regfind $commentPrefix]" $text "" text
  140.     } else {
  141.         regsub -all "(^|\r|\n)[quote::Regfind $commentPrefix]" [getText $start $end] "" text
  142.     }
  143.     
  144.     regsub -all "\[ \t\r\n\]+" [string trim $text] " " text
  145.     } else {
  146.     # Get the leading whitespace of the current line and store length in 'left'
  147.     set front [getLeadingIndent $pos left]
  148.     # fill the text
  149.     regsub -all "\[ \t\r\n\]+" [string trim [getText $start $end]] " " text
  150.     set newFillColumn [expr {$fillColumn - $left}]
  151.     }
  152.     
  153.     # turn single spaces at end of sentences into double
  154.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  155.     #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!][])'"]?) } $text {\1  } text}
  156.  
  157.     # temporarily adjust the fillColumns
  158.     set ol $leftFillColumn
  159.     set or $fillColumn
  160.     set leftFillColumn 0
  161.     set fillColumn $newFillColumn
  162.         
  163.     # break and indent the paragraph
  164.     regsub -all " ?\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  165.     # reset columns
  166.     set leftFillColumn $ol
  167.     set fillColumn  $or
  168.     if {$inComment && $boxComment} {
  169.     global bind::_IndentSpaces
  170.     set newtext ""
  171.     foreach line [split $text "\r\n"] {
  172.         set pad [string range [set bind::_IndentSpaces] 0 [expr {$boxWidth- [string length $line] -2}]]
  173.         lappend newtext "$line$pad$commentSuffix"
  174.     }
  175.     set text "\r[join [lrange $newtext 1 end] \r]"
  176.     }
  177.     
  178.     # don't replace if nothing's changed
  179.     if {"$text\r" != "\r[getText $start $end]"} {
  180.     # workaround an alpha bug
  181.     if {$remember} { 
  182.         getWinInfo a
  183.         if {[pos::compare [rowColToPos $a(currline) 0] > $start]} { goto $start }
  184.     }
  185.     replaceText $start $end "[string range $text 1 end]\r"
  186.     if {$remember} {
  187.         goBackToWhereYouWere $start [pos::math $start + \
  188.           [string length $text]] $memory
  189.     }
  190.     }
  191.     
  192.     # in case we wish to fill a region
  193.     return $end
  194. }
  195.  
  196. ## 
  197.  # -------------------------------------------------------------------------
  198.  # 
  199.  #    "paragraph::start" -- "paragraph::finish"
  200.  # 
  201.  #  "Start": It's pretty clear for non TeX modes how this works.  The only
  202.  #  key is that we start at the beginning of the current line and look
  203.  #  back.  We then have a quick check for whether we found that very
  204.  #  beginning (in which case return it) or if not (in which case we have
  205.  #  found the end of the previous paragraph) we move forward a line.
  206.  # 
  207.  #  "Finish": The only addition is the need for an additional check for
  208.  #  stuff which explicitly ends lines.
  209.  #       
  210.  # Results:
  211.  #  The start/finish position of the paragraph containing the given 'pos'
  212.  # 
  213.  # --Version--Author------------------Changes-------------------------------
  214.  #    1.1     <vince@santafe.edu> Cut down on '()' pairs
  215.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  216.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  217.  #    1.4     <vince@santafe.edu> Handle Tcl lists, top of file fix.
  218.  # -------------------------------------------------------------------------
  219.  ##
  220. proc paragraph::start {pos} {
  221.     global mode 
  222.     global ${mode}::startPara
  223.     if {[pos::compare $pos == [maxPos]]} {set pos [pos::math $pos - 1]}
  224.     set pos [lineStart $pos]
  225.     if {[info exists ${mode}::startPara]} {
  226.     set startPara [set ${mode}::startPara]
  227.     } else {
  228.     switch -- $mode {
  229.         "TeX" -
  230.         "Bib" {
  231.         global texParaCommands
  232.         set startPara {^[ \t]*$|\\\\[ \t]*$|(^|[^\\])%|\\h+line[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  233.         append startPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  234.         } 
  235.         "HTML" {
  236.         global htmlParaCommands
  237.         set startPara {^[ \t]*$|</?(}
  238.         append startPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  239.         }
  240.         default {
  241.         set startPara {^([ \t]*|([\\%].*))$}
  242.         }
  243.     }
  244.     }
  245.  
  246.     set res [search -s -n -f 0 -r 1 -l [minPos] -- "$startPara" $pos]
  247.     if {![llength $res] || $res == "0 0" } {
  248.     # bug work-around.  Alpha fails to match '^' with start of file.
  249.     return [lineStart [lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [minPos]] 0]]
  250.     } elseif {[pos::compare [lindex $res 0] == $pos]} {
  251.     return $pos
  252.     } else {
  253.     return [nextLineStart [lindex $res 0]]
  254.     }
  255.     
  256. }
  257.  
  258. proc paragraph::finish {pos} {
  259.     global mode
  260.     global ${mode}::endPara
  261.     set pos [lineStart $pos]
  262.     set end [maxPos]
  263.     if {[info exists ${mode}::endPara]} {
  264.     set endPara [set ${mode}::endPara]
  265.     } else {
  266.     switch -- $mode {
  267.         "TeX" -
  268.         "Bib" {
  269.         global texParaCommands
  270.         set endPara {^[ \t]*$|(^|[^\\])%|\$\$[ \t]*$|^[ \t]*(\\(}
  271.         append endPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  272.         } 
  273.         "HTML" {
  274.         global htmlParaCommands
  275.         set endPara {^[ \t]*$|</?(}
  276.         append endPara $htmlParaCommands {)([ \t\r\n]+[^>]*>|>)}
  277.         }
  278.         default {
  279.         set endPara {^([ \t]*|([\\%].*))$}
  280.         }
  281.     }
  282.     }
  283.     
  284.     set res [search -s -n -f 1 -r 1 -l $end -- "$endPara" $pos]
  285.     if {![string length $res]} {return $end}
  286.     set cpos [lineStart [lindex $res 0]]
  287.     if {[pos::compare $cpos == $pos]} {
  288.     return [nextLineStart $cpos]
  289.     }
  290.     # A line which ends in '\\', '%...', '\hline', '\hhline'
  291.     # signifies the end of the current paragraph in TeX mode
  292.     # (the above checked for beginning of the next paragraph).
  293.     if { $mode == "TeX" || $mode == "Bib" } {
  294.     set res2 [search -s -n -f 1 -r 1 -l $end {((\\\\|\\h+line)[ \t]*|[^\\]%.*)$} $pos]
  295.     if {[string length $res2]} {
  296.         if {[pos::compare [lindex $res2 0] < $cpos] } {
  297.         return [nextLineStart [lindex $res2 0]]
  298.         }
  299.     }
  300.     }
  301.  
  302.     return $cpos
  303.     
  304. }
  305.  
  306. proc paragraph::select {} {
  307.     set pos [getPos]
  308.     set start [paragraph::start $pos] 
  309.     set finish [paragraph::finish $pos]
  310.     goto $start
  311.     if {[info tclversion] < 8.0} {
  312.     select $start $finish
  313.     } else {
  314.     ::select $start $finish
  315.     }
  316. }
  317.  
  318. proc paragraph::sentence {} {
  319.     set pos [getPos]
  320.     set start [paragraph::start $pos] 
  321.     set finish [paragraph::finish $pos]
  322.     
  323.     set t [string trim [getText $start $finish]]
  324.     set period [regexp {\.$} $t]
  325.     regsub -all "\[ \t\r\n\]+" $t " " text
  326.     regsub -all {\. } $text "Δ" text
  327.     set result ""
  328.     foreach line [split [string trimright $text {.}] "Δ"] {
  329.     if {[string length $line]} {
  330.         append result [breakIntoLines $line] ".\r"
  331.     }
  332.     }
  333.     if {!$period && [regexp {\.\r} $result]} {
  334.     set result [string trimright $result ".\r"]
  335.     append result "\r"
  336.     }
  337.     if {$result != [getText $start $finish]} {
  338.     replaceText $start $finish $result
  339.     }
  340.     goto $pos
  341. }
  342.